home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / soundex2.arc / SOUNDEX2.PRG
Encoding:
Text File  |  1987-04-05  |  4.8 KB  |  141 lines
  1. * Purpose of this program:
  2. *    1. Store the soundex code for every entry in a database file with a 
  3. *       character field containing the last name.
  4. *    2. Enter a last name.  This program generates a soundex code for it,
  5. *       and retrieves all records matching the code.
  6. *    (The codes are case insensitive)
  7. *
  8. *    Original program from the Data Based Advisor, Aug., 1984 page 46
  9. *         By John Gillen, Lexicon Publishing, 725 J Street, 
  10. *              Sacramento, CA 95814
  11. *
  12. *    Adapted to dBASE III and modified June 14, 1985 by 
  13. *         Michael Shunfenthal, 
  14. *              2602 West 235 Street, Torrance CA 90505
  15. *
  16. *    Modified to run faster on September 10, 1985 by
  17. *         Kenneth E. Madl
  18. *              9995 E. Harvard, #M-186, Denver CO 80231
  19. *
  20. *
  21. *    To use this program:
  22. *    1. Modify the structure of your database to add a 4-character field 
  23. *              to hold the soundex code for each last name.  Then enter:
  24. *       set procedure to soundex
  25. *
  26. *    2. Set the code into this field for the entire database:
  27. *              (the program requires approx. 3 seconds for each record)
  28. *       do sreplace with '<dbfname>', '<lastname field>', '<soundex field>'
  29. *
  30. *    3. Retrieve records having the same code for the entered last name:
  31. *       do sdisplay with '<dbfname>', '<last name>', '<soundex field>'
  32. *
  33. *    Notes on above commands: 
  34. *    1. The apostrophes (or double quotes, or brackets) are required
  35. *         per the dBASE III manual, to delimit character values.
  36. *    2. Omit the angle brackets: <>.
  37. *    3. The last name field or entry may have an embedded apostrophe 
  38. *       ("O'Brian"), space, or hyphen.
  39. *
  40. *************************************************************************
  41. *    Program operation: (procedure sndxcalc)
  42. *         Create a Soundex code for the last name parameter 
  43. *         (either a field or variable) and save in public variable sndxcode
  44. *    1. Assign the first letter of the last name to the first digit of
  45. *       the code
  46. *    2. Check for and remove double consonants
  47. *    3. Assign a value to the remaining letters
  48. *    4. Adjust the code length to four characters
  49. *    5. Store this value in the soundex field
  50. *
  51. *    Modifications to the original article listing:
  52. *    1. Added multiple functions:
  53. *         a. Store the soundex code for a given last name field (input)
  54. *            and a given soundex-code field (output) in a given database
  55. *         b. Retrieve names given a last name, last-name field, 
  56. *            and soundex field
  57. *    2. Made more generalized: replaced the hard coded database file name
  58. *       and field names with user-entered parameters
  59. *    3. Fix bugs: ignore apostrophe, hyphen, or space within the last name.
  60. *    4. Fix bugs: ignore second key letter or equivalent when consecutive
  61. *
  62. procedure sreplace
  63. parameter dbfname, lastnmfld, sndxfld
  64. public sndxcode
  65. set talk off
  66. use &dbfname
  67. clear
  68. ? '  Rec #' + space(8) + 'NAME' + space(13) + 'SOUNDEX'
  69. ?
  70. do while .not. eof()
  71.   mlastnm = &lastnmfld
  72.   do sndxcalc with "&mlastnm"
  73.   ? space(2)+str(recno(),4)+space(7)+&lastnmfld+space(7)+sndxcode
  74.   replace &sndxfld with sndxcode
  75.   skip
  76. enddo
  77. ?
  78. wait
  79. set talk on
  80. clear
  81. return
  82.  
  83. procedure sdisplay
  84. parameter dbfname, lastnam, sndxfld
  85. public sndxcode
  86. set talk off
  87. use &dbfname
  88. do sndxcalc with "&lastnam"
  89. ?
  90. ?
  91. ? '  The soundex code for ' + '&lastnam' + ' is ' + sndxcode
  92. ?
  93. display all off for &sndxfld='&sndxcode'
  94. ?
  95. set talk on
  96. return
  97.  
  98. procedure sndxcalc
  99. parameter charname
  100. name  =  upper(trim("&charname"))
  101. if name = '  '
  102.      return
  103. endif
  104. length = len(name)
  105. lettr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ'-, "
  106. numbr = "012301200224550126230102020000"
  107. sndxcode = ' '
  108. *  assign the first letter of the name to the first digit of the code
  109. sndxcode =  substr(name,1,1)
  110. pos = 2
  111. cnt = 2
  112. prior = '0'
  113. *  ignore double consanants at beginning of name
  114. if sndxcode = substr(name,2,1)
  115.      pos = 3
  116. endif
  117. do while pos <= length
  118. *    substitute code number for letter of name
  119.      cnum = substr(numbr,at(substr(name,pos,1),lettr),1)
  120. *    ignore vowels and non-letter characters
  121.      if cnum <> '0'
  122. *         ignore second letter of double letters
  123.           if cnum <> prior
  124. *              code only the first 4 letters of the name
  125.                if cnt <= 4
  126.                     sndxcode = sndxcode + cnum
  127.                     prior = cnum
  128.                     cnt = cnt + 1
  129.                endif pos <= 4
  130.           endif cnum <> prior
  131.       else
  132.           prior = '0'
  133.       endif cnum <> 0
  134.       pos = pos + 1
  135. enddo
  136. *  check for soundex code length less than 4
  137. do while len(sndxcode) < 4
  138.      sndxcode = sndxcode + '0'
  139. enddo
  140. return
  141.